home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
t_os
/
am_dfc7
/
am_dfc7.bas
next >
Wrap
BASIC Source File
|
1993-11-30
|
11KB
|
291 lines
1000 CLEAR ,,4096,1024*720
1010 DEFINT A-Z:BGM 1:FOR I=0 TO 13:PART I,I:NEXT:MOUSE 0
1020 SCREEN@ 0:SCREEN 0:CLS:COLOR ,,,4:CONSOLE 0,25,0:ON ERROR GOTO *TRAP
1030 DIM UNDO&(38400),UNDO2&(38400),CCD(15),TRP(5120)
1040 LM=14
1050 DIM FM(LM),PCM(LM),MLOOP(LM),FL$(LM),SW(LM),MN$(LM+1),TRK(5),M$(127)
1060 T&=63724/2:DIM O_TRK(T&),Q_TRK(T&),P_TRK(T&),R_TRK(T&),S_TRK(T&)
1070 T&=13990/2:DIM O_INT(T&),Q_INT(T&),P_INT(T&),R_INT(T&),S_INT(T&)
1080 DIM FMB$(9),PMB$(9),DFILE$(9)
1090 MX=0:MY=0:LX=256:LY=15:T_LP=0:MCOU=24
1100 みかげ=0:表紙=0:FLG=0
1110 NFM=999:NPCM=999:NMML=999
1120 TRK(1)=999:TRK(2)=999:TRK(3)=999:TRK(4)=999:TRK(5)=999
1130 GOSUB *DATA_DIVISION
1140 CLS
1150 '
1160 WHILE -1:LSY=16:UPD=0
1170 IF 表紙<>2 THEN GOSUB *画面描く:MENU=0:MMENU=2:GOSUB *LINE_XOR
1180 MOUSE 1,0,0,0
1190 GOSUB *SELECT_MENU:IF PT>1 THEN GOSUB *M_STOP:UMENU=MENU:MENU=-1
1200 GOSUB *LINE_XOR:MAINMENU=MENU
1210 ON MENU+1 GOSUB *MUSIC_MODE,*DOC_READ,*SYS_RET
1220 IF MENU=-1 THEN 表紙=2:MENU=UMENU ELSE 表紙=1
1230 WEND
1240 '
1250 *SELECT_MENU:MOUSE 4,0,0,15,MMENU*16+15
1260 PT=0 : IF MAINMENU<>3 THEN GOSUB *PT_WAIT
1270 WHILE PT=0
1280 GOSUB *MS_GET:PT=-MOUSE(2,0) OR -MOUSE(2,1)*2
1290 IF PLAY(0)=0 AND FLG THEN GOSUB *MUSIC_ERASE
1300 WEND
1310 RETURN
1320 '
1330 *MUSIC_ERASE:FLG=0
1340 LINE(0,339)-(317,377),PSET,%1,BF:RETURN
1350 *MS_GET
1360 PD=MOUSE(1)\16
1370 IF PD<>UPD THEN GOSUB *MOVE_MENU
1380 RETURN
1390 *LINE_XOR:Y=MENU*LSY
1400 LINE(MX,MY+Y)-(MX+LX,MY+LY+Y),XOR,%3,BF
1410 RETURN
1420 *MOVE_MENU
1430 GOSUB *LINE_XOR:MENU=PD:SWAP C1,C2:GOSUB *LINE_XOR:UPD=PD
1440 RETURN
1450 *MOUSE_COUNT:MOUSE 3,1,MCOU:MOUSE 3,0,MCOU:RETURN
1460 *PT_WAIT:WHILE MOUSE(2,0) OR MOUSE(2,1):WEND:RETURN
1470 *MS_WAIT2:B=80 : A=1 : WHILE A:A=MOUSE(2,0):B=B-1
1480 IF B=0 THEN A=0
1490 WEND : RETURN
1500 *WAIT_REP:WAIT 1:WAIT 1:WAIT 1:WAIT 1:RETURN
1510 *BEEP_SE:FOR Z=0 TO 4:BEEP 363523,1,1200:WAIT 8:NEXT:RETURN
1520 *SCREEN_OUT:SX=319
1530 *SCREEN_OUT2
1540 FOR I=0 TO L\2
1550 LINE(0,I*2)-STEP(SX,0),PSET,0
1560 LINE(0,L-1-I*2)-STEP(SX,0),PSET,0:WAIT 1
1570 NEXT:RETURN
1580 '
1620 *画面描く
1630 LINE (0,0)-(255,255),PSET,%1,BF:LX=255
1640 IF 表紙=0 THEN GOSUB *画面描く2:RETURN
1650 PUT@A(0,0)-(639,479),UNDO&:RETURN
1660 *画面描く2:LINE(MX,MY)-(MX+640,MY+399),PSET,%1,BF
1670 GOSUB *画面描く3
1680 LOAD@"apple_3b.tif",(320,0)
1690 SYMBOL(MX,MY ),"曲を聴く",1,1,7,,,5,1
1700 SYMBOL(MX,MY+16),"ドキュメントを読む",1,1,7,,,5,1
1710 SYMBOL(MX,MY+32),"システムに戻る",1,1,7,,,5,1
1720 GET@A(0,0)-(639,479),UNDO&:RETURN
1730 *画面描く3
1740 SYMBOL(31,410),"TwinkleSoft音楽集 VOL.2",2,3,4
1750 SYMBOL(32,410),"TwinkleSoft音楽集 VOL.2",2,3,4
1760 SYMBOL(192,457),"by Twinkle SOFT",1,1.5!,7,,,1
1770 RETURN
1780 '
1790 *SYS_RET
1800 SYMBOL(32,256),"本当にいいですか? yes>LEFT push --- no>RIGHT push",1,1,7
1810 GOSUB *BEEP_SE:GOSUB *PT_WAIT
1820 PT=0:WHILE PT=0:PT=-MOUSE(2,0) OR -MOUSE(2,1)*2:WEND
1830 IF PT=1 THEN L=480:GOSUB *SCREEN_OUT:SYSTEM
1840 LINE(32,128)-(23*16+32,143),PSET,%1,BF:GOSUB *PT_WAIT:RETURN
1850 *DOC_READ
1860 L=480:SX=639:GOSUB *SCREEN_OUT2:EOM=1
1870 WHILE EOM:A=1:B=7:C!=1.5!
1880 LINE(MX,MY)-(MX+640,MY+480),PSET,%A,BF
1890 SYMBOL(MX,MY ),"by TwinkleSoft",C!,A,B
1900 SYMBOL(MX,MY+16),"by 編曲主任",C!,A,B
1910 SYMBOL(MX,MY+32),"あとがき",C!,A,B
1920 SYMBOL(MX,MY+48),"戻る",C!,A,B
1930 MENU=0:MMENU=3:GOSUB *LINE_XOR:GOSUB *PT_WAIT:UPD=0:MOUSE 1,0,0,0
1940 GOSUB *SELECT_MENU
1950 IF PT=1 THEN GOSUB *DOC_FILER ELSE GOSUB *M_STOP
1960 WEND
1970 RETURN
1980 *DOC_FILER
1990 IF MENU=MMENU THEN EOM=0:RETURN
2000 FOR I=0 TO 26:M$(I)="":NEXT
2010 OPEN "I",#1,DFILE$(MENU)+".doc":I=0
2020 WHILE EOF(1)=0
2030 LINE INPUT #1,M$(I):I=I+1
2040 WEND:CLOSE #1:M=I
2050 LINE(MX,MY)-(MX+640,MY+480),PSET,%1,BF
2060 LINE(0,464)-(639,479),PSET,%2,BF
2070 SYMBOL(64,464),"左クリックしてね!",1.5!,1,7,,,1
2080 LOCATE 0,0:GOSUB *PT_WAIT
2090 FOR I=0 TO 23:PRINT M$(I):NEXT:D=1
2100 WHILE D:PT=0:A1=0:A2=0
2110 WHILE PT=0:PT=A1 OR A2:A1=-MOUSE(2,0):A2=-MOUSE(2,1)*2:WEND
2120 IF PT=2 THEN PT=2 ELSE GOSUB *DOC_NEXT
2130 WEND
2140 LINE(0,464)-(639,479),PSET,%2,BF
2150 SYMBOL(64,464),"右クリックで終了します。",1.5!,1,7,,,1
2160 GOSUB *BEEP_SE
2170 WHILE MOUSE(2,1)=0:WEND
2180 CLS 4:LINE(0,464)-(639,479),PSET,%1,BF
2190 RETURN
2200 *DOC_NEXT
2210 PRINT M$(I):I=I+1:GOSUB *MS_WAIT2:IF I>=M THEN D=0
2220 RETURN
2230 '
2240 '
2250 *MUSIC_MODE:GOSUB *PT_WAIT
2260 L=400:LX=480:GOSUB *SCREEN_OUT
2270 LINE(MX,MY)-(MX+319,MY+399),PSET,%1,BF
2280 IF みかげ THEN GOSUB *みかげちゃん愛してる!
2290 IF みかげ=0 THEN GOSUB *みかげちゃんこんにちわ!
2300 '
2310 LX=319:MENU=0:MMENU=LM+1:LSY=16:GOSUB *LINE_XOR:EOM=1
2320 MOUSE 1,0,0,0:UPD=0
2330 IF PLAY(0) THEN GOSUB *MUSIC_NOW_SYMBOL
2340 WHILE EOM
2350 GOSUB *SELECT_MENU
2360 IF PT=1 AND MENU=MMENU THEN EOM=0
2370 IF PT>1 THEN GOSUB *M_STOP ELSE GOSUB *M_LOAD_INIT
2380 WEND
2390 FLG=0:L=400:GOSUB *SCREEN_OUT
2400 RETURN
2410 *みかげちゃんこんにちわ!:GOSUB *M_STOP
2420 LINE(MX,MY)-(MX+319,MY+368),PSET,%1,BF
2480 X=0:FOR I=0 TO LM+1:SYMBOL(X,I*16),MN$(I),1,1,%15:NEXT
2490 GET@A(0,0)-(639,479),UNDO2&:みかげ=1
2500 RETURN
2510 *みかげちゃん愛してる!
2520 PUT@A(0,0)-(639,479),UNDO2&
2530 RETURN
2540 *M_STOP:PLAY OFF:RETURN
2550 *M_LOAD_INIT : IF EOM=0 THEN RETURN
2560 UY=MOUSE(1)
2570 MML=MENU:FILE$=FL$(MENU):FM=FM(MENU):PCM=PCM(MENU)
2580 SW=SW(MENU):GOSUB *M_STOP:GOSUB *FM_LOADER:GOSUB *PCM_LOADER
2590 GOSUB *MUSIC_LOADER
2600 SYMBOL(40,380),"ちょっと待っててね!",1.5!,1,%1
2610 'FOR I=1 TO 5:LRU(I)=(LRU(I)+1)AND 32767:NEXT:LRU(T)=0
2620 MOUSE 1,0,UY,0:RETURN
2630 *MUSIC_NOW_SYMBOL
2640 LINE(0,339)-(317,377),PSET,%15,BF,%1
2650 SYMBOL(64,340),"now PLAYING♪",1,1,7
2660 SYMBOL(0,359),MN$(MML),1,1,7:FLG=1:RETURN
2670 *MUSIC_LOADER
2680 PLAY OFF : GOSUB *MUSIC_NOW_SYMBOL
2690 A$="%C":PLAY A$,A$,A$,A$,A$,A$, A$,A$,A$,A$,A$,A$,A$,A$
2700 IF MML<>NMML THEN GOSUB *MUSIC_LOADER2
2710 RETURN
2720 '
2730 *MUSIC_LOADER2
2740 IF MLOOP(MENU)=999 THEN A=0 ELSE A=1
2750 GOSUB *MML_LOADER_CK:IF CK THEN RETURN
2760 M_TRK=T:TRK(T)=MML
2770 ON T GOSUB *O_TRK,*P_TRK,*Q_TRK,*R_TRK,*S_TRK
2780 RETURN
2790 *O_TRK
2800 IF SW THEN LOAD@ FILE$+"L.eup",O_INT,1
2810 LOAD@ FILE$+".eup",O_TRK,1:GOSUB *O_PLAY:RETURN
2820 *P_TRK
2830 IF SW THEN LOAD@ FILE$+"L.eup",P_INT,1
2840 LOAD@ FILE$+".eup",P_TRK,1:GOSUB *P_PLAY:RETURN
2850 *Q_TRK
2860 IF SW THEN LOAD@ FILE$+"L.eup",Q_INT,1
2870 LOAD@ FILE$+".eup",Q_TRK,1:GOSUB *Q_PLAY:RETURN
2880 *R_TRK
2890 IF SW THEN LOAD@ FILE$+"l.eup",R_INT,1
2900 LOAD@ FILE$+".eup",R_TRK,1:GOSUB *R_PLAY:RETURN
2910 *S_TRK
2920 IF SW THEN LOAD@ FILE$+"l.eup",S_INT,1
2930 LOAD@ FILE$+".eup",S_TRK,1:GOSUB *S_PLAY:RETURN
2940 '
2950 *MML_LOADER_CK:CK=0
2960 IF TRK(1)=MML THEN M_TRK=1:CK=1:GOSUB *O_PLAY:RETURN
2970 IF TRK(2)=MML THEN M_TRK=2:CK=1:GOSUB *P_PLAY:RETURN
2980 IF TRK(3)=MML THEN M_TRK=3:CK=1:GOSUB *Q_PLAY:RETURN
2990 IF TRK(4)=MML THEN M_TRK=4:CK=1:GOSUB *R_PLAY:RETURN
3000 IF TRK(5)=MML THEN M_TRK=5:CK=1:GOSUB *S_PLAY:RETURN
3010 T_LP=(T_LP+1)MOD 5:T=T_LP+1
3020 RETURN
3030 *O_PLAY:GOSUB *INTRO:PLAY@ O_TRK,A:RETURN
3040 *P_PLAY:GOSUB *INTRO:PLAY@ P_TRK,A:RETURN
3050 *Q_PLAY:GOSUB *INTRO:PLAY@ Q_TRK,A:RETURN
3060 *R_PLAY:GOSUB *INTRO:PLAY@ R_TRK,A:RETURN
3070 *S_PLAY:GOSUB *INTRO:PLAY@ S_TRK,A:RETURN
3080 *O_IT:PLAY@ O_INT,0:RETURN
3090 *P_IT:PLAY@ P_INT,0:RETURN
3100 *Q_IT:PLAY@ Q_INT,0:RETURN
3110 *R_IT:PLAY@ R_INT,0:RETURN
3120 *S_IT:PLAY@ S_INT,0:RETURN
3130 *INTRO:IF SW(MENU)=0 THEN RETURN
3140 T=M_TRK:ON T GOSUB *O_IT,*P_IT,*Q_IT,*R_IT,*S_IT
3150 SYMBOL(40,380),"ちょっと待っててね!",1.5!,1,%15
3160 WHILE PLAY(0):WEND
3170 RETURN
3180 '
3190 '
3200 *PCM_LOADER:E=0
3210 IF PCM=NPCM THEN RETURN ELSE PLAY OFF:E=1
3220 IF PCM THEN N$=PMB$(PCM):GOSUB *PMB_READ
3230 RETURN
3240 *PMB_READ : IF E THEN LOAD@ N$+".pmb":NPCM=PCM
3250 RETURN
3260 '
3270 *FM_LOADER:E=0
3280 IF FM=NFM THEN RETURN ELSE PLAY OFF:E=1
3290 IF FM THEN N$=FMB$(FM):GOSUB *FMB_READ
3300 RETURN
3310 *FMB_READ : IF E THEN LOAD@ N$+".fmb":NFM=FM
3320 RETURN
3330 '
3340 *DATA_DIVISION:RESTORE *DATA_DIVISION
3350 DFILE$(0)="twinkle":DFILE$(1)="has":DFILE$(2)="atogaki"
3360 FMB$(1)="CY_VOICE":FMB$(2)="xacs_fm2"
3370 PMB$(1)="cy_lips" :PMB$(2)="CY_LIPS1"
3380 PMB$(4)="cy_lips4":PMB$(5)="cy_lipsE":PMB$(6)="CY_LIPS6"
3390 PMB$(9)="pcm_05"
3400 FOR I=0 TO LM
3410 READ FL$(I):READ FM(I),PCM(I),MLOOP(I),SW(I)
3420 NEXT
3430 RESTORE *NAME_DIVISION
3440 FOR I=0 TO LM:READ MN$(I):NEXT:MN$(I)=" 戻る"
3460 RETURN
3470 ' file fm pcm loop sw
3480 DATA open_b , 1, 1, 999, 0
3490 DATA STAGE1 , 1, 1, 0, 1
3500 DATA BOSS_1 , 1, 2, 0, 0
3510 DATA stage4 , 1, 4, 0, 0
3520 DATA stage5 , 1, 1, 0, 1
3530 DATA boss_5 , 1, 1, 0, 0
3540 DATA STAGE6 , 1, 6, 0, 1
3550 DATA BOSS_6 , 1, 6, 0, 0
3560 DATA ending_a, 1, 5, 999, 0
3570 DATA ramin , 1, 1, 0, 0
3580 DATA xacs013 , 2, 9, 0, 1
3590 DATA xacs010 , 2, 9, 0, 1
3600 DATA xacs007 , 2, 9, 0, 1
3610 DATA xacs033 , 2, 9, 0, 0
3620 DATA m_67a , 2, 0, 0, 0
3630 '
3640 *NAME_DIVISION
3650 '限界点-------------------|
3660 DATA CY-LIPS Innermost keepers
3670 DATA CY-LIPS Destructive Instinct
3680 DATA CY-LIPS DNA-DRAGON
3690 DATA CY-LIPS DIRECT ARTS
3700 DATA CY-LIPS Elegant assault
3710 DATA CY-LIPS EverShip
3720 DATA CY-LIPS D-BEAT
3730 DATA CY-LIPS NO comparison
3740 DATA CY-LIPS HISTORY ONE MORE
3750 DATA CY-LIPS 常駐のテーマ
3760 DATA Legend of Calsurn save your heart
3770 DATA Legend of Calsurn We?
3780 DATA Legend of Calsurn 戦闘
3790 DATA Legend of Calsurn MOT MIX
3800 DATA Legend of Calsurn 雪世界
3810 '
3820 'palette
3830 'DATA 273,1648,1437,1966,2511, 231,2298,3069
3840 'DATA 2569,3386,4013,2535,3065,3579,4093,4095
3850 *TRAP
3860 IF ERR=53 THEN RESUME NEXT
3870 FOR I=0 TO 31:BEEP 363523,1,1200:WAIT 1:BEEP 363523,1,1800:NEXT
3880 GET@A(0,400)-(639,431),TRP
3890 IF ERR=72 THEN GOSUB *FD_NOT_READY:RESUME
3900 LINE(0,400)-(639,479),PSET,%0,BF
3910 SYMBOL(0,416),"エラー発生 ERR="+STR$(ERR),1,1,7
3920 SYMBOL(0,432)," ERL="+STR$(ERL),1,1,7
3930 GOSUB *PT_WAIT:WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND:END:SYSTEM
3940 *FD_NOT_READY
3950 SYMBOL(0,400),"フロッピーはいってないです",1.2!,1.4!,%15
3960 GOSUB *PT_WAIT:WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND
3970 GOSUB *PT_WAIT:PUT@A(0,400)-(639,431),TRP
3980 RETURN